perm filename FILDIS.F4[TMP,LCS] blob sn#147683 filedate 1975-02-24 generic text, type C, neo UTF8
COMMENT āŠ—   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002		DIMENSION QQ(200),NE(200),II(3000)
C00004 ENDMK
CāŠ—;
	DIMENSION QQ(200),NE(200),II(3000)
	EQUIVALENCE (QQ,NE)
111	CALL DPYSET(1,II,3000)
	CALL SETCUR(0,0,0)
	I=1
7	JOIN=I
1	ACCEPT 2,L
2	FORMAT(A1)
	CALL RDCUR(NX,NY)
	IF(L.EQ.'F')GO TO 22
	IF(L.EQ.'J')GO TO 33
	QQ(I)=NX
	QQ(I+1)=NY
	NE(I+2)=2
	IF(I.EQ.JOIN)NE(I+2)=3
	CALL LINES(QQ(I),QQ(I+1),NE(I+2))
	CALL DPYOUT(1)
	I=I+3
	GO TO 1
33	QQ(I)=QQ(JOIN)
	QQ(I+1)=QQ(JOIN+1)
	NE(I+2)=2
	CALL LINES(QQ(I),QQ(I+1),2)
	CALL DPYOUT(1)
	I=I+3
	GO TO 7
22	NE(3)=I-1
	TYPE 4
4	FORMAT(' INC= '$)
	ACCEPT 5,M
5	FORMAT(I)
	CALL FILLER(QQ,M)
	CALL DPYOUT(1)
	ACCEPT 2,L
	GO TO 111
	END

	SUBROUTINE LINES(RX,RY,J)
	NX=RX
	NY=RY
	IF(J.EQ.3)GO TO 1
	CALL AVECT(NX,NY)
	RETURN
1	CALL AIVECT(NX,NY)
	END